;;; tp-muse-highlight.el --- Tags for syntax-highlighting with muse

;; Copyright (C) 2003  Free Software Foundation, Inc.

;; This file is adopted to muse by Na Li <wuolong@gmail.com>
;; from tp-ew-highlight.el by Ulrik Jensen <terryp@daimi.au.dk>
;; which can be found at
;;   http://www.daimi.au.dk/~terryp/tp-ew-highlight.el

;; muse can be found at <http://www.emacswiki.org/cgi-bin/wiki/MuseMode>
;; htmlize can be found at <http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el>

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This has been tested with htmlize-version 1.6, and muse
;; mwolson@gnu.org--2005/muse--main--1.0--patch-253.
;; No guarantees though.

;; Example-usage:
;; .emacs:
;;   ;; add my custom tags
;;
;;   (tp-muse-html-syntax-highlight-tag "sasexample" 'sas-mode)

;; In a wiki-page
;;  <sasexample>
;;    code--here
;;  </sasexample>

;; To create your stylesheet, use htmlize-buffer on an example-file, and
;; copy-paste the stylesheet from that buffer. This way, it'll match your
;; color-settings.

;;; Code:

(require 'htmlize)
(require 'muse)

(defun muse-multiline-maybe (beg end &optional predicate)
  "If region between BED and END is a multi-line region, and the
optional PREDICATE is true, font lock the current region as
multi-line.

PREDICATE is called with the excursion saved."
  (when (and (or (eq (char-before end) ?\n)
                 (> (count-lines beg end) 1))
             (or (not predicate)
                 (save-excursion (funcall predicate beg end))))
    (save-excursion
      ;; mark whole lines as a multiline font-lock
      (goto-char beg)
      (setq beg (line-beginning-position))
      (goto-char end)
      (setq end (line-end-position))
      (add-text-properties beg end '(font-lock-multiline t))
      t)))

(defun tp-muse-fontified-example-tag (beg end highlight-p mode)
  (if highlight-p
      (progn
        (muse-multiline-maybe beg end)
        (goto-char end))
    ;; else
    (let ((content (buffer-substring beg end))
          (replacement ""))
      ;; we've saved the content - now delete it.
      (delete-region beg end)
      (save-excursion
        (with-temp-buffer
          (insert content)
          ;; strip beginning newlines!
          (goto-char (point-min))
          (while (looking-at "^$")
            (forward-line))
          (delete-region (point-min) (point))
          ;; set mode
          (funcall mode)
          ;; Turn on font-locking, otherwise htmlize won't be much good
          (font-lock-fontify-buffer)
          ;; send buffer to htmlize-buffer
          (save-excursion
            (set-buffer (htmlize-buffer))
            ;; pickup and insert
            (goto-char (point-min))
            (search-forward "<pre>\n")
            (let ((beginreg (point)))
              (search-forward "</pre>")
              (backward-char 6)
              (setq replacement (buffer-substring beginreg (point)))
              (kill-buffer (current-buffer))))))
      (let ((current-begin (point)))
        (insert "<pre class=\"sourcecode\">\n")
        (insert replacement)
        (insert "</pre>\n")
        (add-text-properties current-begin (point)
                             '(rear-nonsticky (read-only)
                                              read-only t))))))

(defun tp-muse-html-syntax-highlight-tag (tagname mode)
  (let ((symbolname (concat "tp-muse-autogenerated-highlight-tag-"
                            (symbol-name mode))))
    ;; Create the function for this exact symbol
    (fset (intern symbolname)
          `(lambda (beg end)
             (tp-muse-fontified-example-tag beg end nil (quote ,mode))))
    ;; Associate it with it's tag
    (add-to-list 'muse-html-markup-tags
                 `(,tagname t nil ,(intern symbolname)) t)))

;; some default tags
(tp-muse-html-syntax-highlight-tag "cppexample" 'c++-mode)
(tp-muse-html-syntax-highlight-tag "htmlexample" 'html-mode)
(tp-muse-html-syntax-highlight-tag "lispexample" 'lisp-mode)
(tp-muse-html-syntax-highlight-tag "cexample" 'c-mode)

(provide 'tp-muse-highlight)
;;; tp-muse-highlight.el ends here